home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / think.tcl < prev    next >
Encoding:
Text File  |  1994-07-07  |  7.4 KB  |  329 lines  |  [TEXT/ALFA]
  1.  
  2.  
  3. set THINK "THINK Project Manager"
  4. #set THINK "AEvent Display 1.3"
  5.  
  6. # Get name Alpha's current name.
  7. foreach p [processes] {
  8.     if {[lindex $p 1] == "ALFA"} {
  9.         set ALPHA [lindex $p 0]
  10.         break
  11.     }
  12. }
  13.  
  14. # The following flags affect the "Run" command.
  15. set runWithDebugger        1
  16. set runWithGo             1
  17. # 'ask ', 'yes ', or 'no  '
  18. set runWithUpdate         "'yes '"
  19. set    runWithSaveDirty    "'yes '"
  20.  
  21.  
  22. proc thinkNumFiles {} {
  23.     global THINK
  24.     set str [AEBuild -r $THINK "core" "cnte" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('SFIL')"]
  25.     if {[regexp {[0-9]+} $str mtch]} {
  26.         return $mtch
  27.     } else {
  28.         error "Bad numfiles"
  29.     }
  30. }
  31.  
  32.  
  33.  
  34. # Get list of files in current project.
  35. proc projectFileList args {
  36.     watchCursor
  37.     checkRunning ThinkC KAHL thinkName
  38.     set num [thinkNumFiles]
  39.     set files {}
  40.     if {[llength $args]} {
  41.         for {set i 1} {$i<=$num} {incr i} {
  42.             lappend files [thinkFileName -p $i]
  43.         }
  44.     } else {
  45.         for {set i 1} {$i<=$num} {incr i} {
  46.             lappend files [thinkFileName $i]
  47.         }
  48.     }
  49.     return $files
  50. }
  51.  
  52.  
  53.  
  54.  
  55. #================================================================================
  56.  
  57.  
  58. proc think {} {
  59.     set name [checkRunning ThinkC KAHL thinkName]
  60.     if {![string length $name]} return
  61.     switchTo $name
  62. }
  63.  
  64. proc searchNextFile {} {
  65.     thinkFinf
  66. }
  67.  
  68.  
  69. proc getProjectFiles args {
  70.     menu -n {Project Files} -m -p projFile [lsort [projectFileList -p]]
  71. }
  72.  
  73. proc projFile {menu name} {
  74.     edit [thinkFileName $name]
  75. }
  76.  
  77.  
  78. #===========================================================================
  79. # Add fileset.
  80. #===========================================================================
  81. proc createThinkFileset {} {
  82.     global fileSets
  83.     global currFileSet
  84.     
  85.     set name [prompt "Fileset name? " "Project"]
  86.     set fileSets($name) [projectFileList]
  87.     addMenuItem -m choose $name
  88.     set currFileSet $name
  89.  
  90.     if {[askyesno "Save project fileset?"] == "yes"} {
  91.         addUserLine "set \"fileSets($name)\" \{$fileSets($name)\}"
  92.         addUserLine "addMenuItem choose \"$name\""
  93.     }
  94.     makeFilesetMenu
  95. }
  96.  
  97. #================================================================================
  98.  
  99. proc checkIncludepath {} {
  100.     global includePath
  101.     set bad 0
  102.     if {![info exists includePath]} {return [setIncludepath]}
  103.     foreach p [subVars $includePath] {
  104.         if {![file exists $p]} {set bad 1}
  105.     }
  106.     if ($bad) setIncludepath
  107. }
  108.  
  109. proc setIncludepath {} {
  110.     global includePath HOME
  111.     
  112.     set includePath {}
  113.     
  114.     while {![catch {set path [get_directory]}]} {
  115.         lappend includePath $path
  116.     }
  117.     
  118.     set fid [open "$HOME:Tcl:SystemCode:definitions.tcl" "a"]
  119.     puts $fid "set includePath \"$includePath\""
  120.     close $fid
  121. }
  122.  
  123. proc openHeader {} {
  124.     global includePath
  125.  
  126.     checkIncludepath
  127.     set path [subVars $includePath]
  128.     set fname [getSelect]
  129.     if {[string last ".h" $fname]=="-1"} {
  130.         set fname ${fname}.h
  131.     }
  132.     set win [lindex [winNames -f] 0]
  133.     if {[string match *:* $win]} {
  134.         lappend path [file dirname $win]
  135.     }
  136.     foreach dir $path {
  137.         if {[file exists $dir:$fname]} {
  138.             edit $dir:$fname
  139.             return
  140.         }
  141.     }
  142.     beep
  143.     message "No such header file"
  144. }
  145.  
  146. #================================================================================
  147.  
  148. proc sendOpenEvent {filler appname fname} {
  149.     AEBuild $appname aevt odoc "----" [concat {[alis(«} [coerce TEXT $fname -x alis] {»)]}]
  150. }
  151.  
  152. proc compile {} {
  153.     sendCompileEvent CMPL "-q"
  154. }
  155.  
  156. proc checkSyntax {} {
  157.     sendCompileEvent SNTX "-q"
  158. }
  159.  
  160. proc disassemble {} {
  161.     global THINK ALPHA
  162.     set tname [checkRunning ThinkC KAHL thinkName]
  163.     set name [lindex [winNames -f] 0]
  164.     switchTo $tname
  165.     set res [AEBuild -r $tname KAHL DASM CFLG long(32) "----" [fileObject $name]]
  166.     switchTo $ALPHA
  167.     new
  168.     regexp {“.*”} $res text
  169.     insertText [string trim $text {“”}]
  170. }
  171.  
  172. proc preprocess {} {
  173.     global THINK ALPHA
  174.     set tname [checkRunning ThinkC KAHL thinkName]
  175.     set name [lindex [winNames -f] 0]
  176.     switchTo $tname
  177.     set res [AEBuild -r $tname KAHL PRCS CFLG long(32) "----" [fileObject $name]]
  178.     switchTo $ALPHA
  179.     new
  180.     regexp {“.*”} $res text
  181.     insertText [string trim $text {“”}]
  182. }
  183.  
  184.  
  185. proc sendCompileEvent {event arg} {
  186.     global THINK ALPHA
  187.     set tname [checkRunning ThinkC KAHL thinkName]
  188.     set name [lindex [winNames -f] 0]
  189.     switchTo $tname
  190.     if {[string length $arg]} {
  191.         set res [AEBuild $arg $tname KAHL  $event "----" [fileObject $name]]
  192.     } else {
  193.         set res [AEBuild $tname KAHL  $event "----" [fileObject $name]]
  194.     }
  195.     switchTo $ALPHA
  196.     return $res
  197. }
  198.  
  199.  
  200. proc add {} {
  201.     global THINK
  202.     set fname [lindex [winNames -f] 0]
  203.     AEBuild $THINK core crel "data" [makeAlis $fname] "kocl" "type('SFIL')"
  204. }
  205.  
  206. proc addAndCompile {} {
  207.     add
  208.     compile
  209. }
  210.  
  211.  
  212. proc precompile {} {
  213.     sendCompileEvent PCMP ""
  214. }
  215.  
  216. proc bringUpToDate {} {
  217.     global THINK ALPHA
  218.     set name [checkRunning ThinkC KAHL thinkName]
  219.     switchTo $name
  220.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  221.     switchTo $ALPHA
  222.     return $res
  223. }
  224.  
  225. proc make {} {
  226.     global THINK ALPHA
  227.     set name [checkRunning ThinkC KAHL thinkName]
  228.     switchTo $name
  229.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  230. }
  231.  
  232. proc run {} {
  233.     global runWithDebugger runWithGo runWithUpdate runWithSaveDirty THINK
  234.     set name [checkRunning ThinkC KAHL thinkName]
  235.     set dbug [expr {$runWithDebugger ? "bool(«01»)" : "bool(«00»)"}]
  236.     set go [expr {$runWithGo ? "bool(«01»)" : "bool(«00»)"}]
  237.     switchTo $name
  238.     AEBuild $name KAHL "RUN " "DBUG" $dbug  "GO  " $go "UPDT" $runWithUpdate "savo" $runWithSaveDirty
  239. }
  240.  
  241. proc debug {} {
  242.     global THINK 
  243.     set fname [lindex [winNames -f] 0]
  244.     set row [expr [lindex [posToRowCol [getPos]] 0] - 1]
  245.     set res [AEBuild $THINK KAHL DBGF "----" [makeAlis $fname] LNNO "short($row)" ]
  246. }
  247.  
  248. proc cnt {} {
  249.     global THINK
  250.     AEBuild -t 6000 -r $THINK core cnte "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('sfil')"
  251. }
  252.  
  253. proc thinkFileName {arg} {
  254.     global THINK
  255.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'indx',\ seld:} $arg {\},\ form:'prop',\ seld:type('FSS\ ')\}}] ""]
  256.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  257.     regexp {«.*»} $blah blah
  258.     return [specToPathName [string trim $blah {«»}]]
  259. }
  260.  
  261.  
  262. #================================================================================
  263.         
  264. proc handleThinkReply { l } {
  265.     global thinkErrors teIndex ALPHA tileHeight winModes terrMenu
  266.     set thinkErrors $l
  267.     switchTo $ALPHA
  268.     set teIndex 0
  269.     
  270.     set errs "Next Previous (-"
  271.     foreach err $l {
  272.         lappend errs "[file tail [lindex $err 0]]:[lindex $err 2]"
  273.     }
  274.     menu -m -n $terrMenu -p terrorProc $errs
  275.     insertMenu $terrMenu
  276.     toThinkError 0
  277. }
  278.  
  279.  
  280. proc terrorProc {menu item} {
  281.     global thinkErrors
  282.     if {$item == "Next"} {return [tnextError]}
  283.     if {$item == "Previous"} {return [tpreviousError]}
  284.     
  285.     set ind [string first ":" $item]
  286.     set nm [string range $item 0 [expr $ind - 1]]
  287.     set ln [string range $item [expr $ind + 1] end]
  288.     set i 0
  289.     foreach err $thinkErrors {
  290.         if {([lindex $err 2] == $ln) && ([file tail [lindex $err 0]] == $nm)} {
  291.             return [toThinkError $i]
  292.         }
  293.         incr i
  294.     }
  295. }
  296.  
  297. proc tpreviousError {} {
  298.     global teIndex
  299.     
  300.     incr teIndex -1
  301.     if {$teIndex < 0} {set teIndex 0}
  302.     toThinkError $teIndex
  303. }
  304.  
  305. proc tnextError {} {
  306.     global teIndex thinkErrors
  307.     incr teIndex
  308.     set limit [expr [llength $thinkErrors] - 1]
  309.     if {$teIndex > $limit} {set teIndex $limit}
  310.     toThinkError $teIndex
  311. }
  312.  
  313.  
  314. proc toThinkError {ind} {
  315.     global thinkErrors tileHeight tileTop tileWidth
  316.     set err [lindex $thinkErrors $ind]
  317.     set fname [lindex $err 0]
  318.     set error [lindex $err 1]
  319.     set ln [lindex $err 2]
  320.     
  321.     if {[catch {bringToFront $fname}] } {
  322.         edit $fname
  323.     }
  324.     set pos [rowColToPos $ln 0]
  325.     select $pos [nextLineStart $pos]
  326.     message $error
  327. }
  328.  
  329.